home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / HFTUBE.ZIP / ANTIPRE.PAS < prev    next >
Pascal/Delphi Source File  |  1995-04-27  |  2KB  |  50 lines
  1. Program AntiPre;
  2. {$M 4096,0,0}
  3. Uses Crt;
  4. Var Fil:File;
  5.     I,N,M,R,G,B,NearDist,Dist,ColorSeg:Word;
  6.     Rd,Gd,Bd:Integer;
  7.     Err,Col:Byte;
  8.     Palette:Array[0..767] Of Byte;
  9. Begin
  10.  Asm Mov   Err,00h
  11.      Mov   Ah,48h
  12.      Mov   Bx,1000h
  13.      Int   21h
  14.      Adc   Err,00h
  15.      Mov   ColorSeg,Ax
  16.  End;
  17.  If Err>0 Then Begin WriteLn('Not enough memory!'); Halt(1); End;
  18.  {$I-}
  19.  Assign(Fil,ParamStr(1)); Reset(Fil,1);
  20.  If IOResult<>0 Then Begin WriteLn('File not found!'); Halt(1); End;
  21.  {Seek(Fil,32);} BlockRead(Fil,Palette,768); Close(Fil);
  22.  Asm Mov Ax,0003h; Int 10h; End;
  23. { For N:=0 to 767 Do Palette[N]:=Palette[N] Shr 2;}
  24.  For N:=0 to 255 Do For M:=0 to 255 Do Begin
  25.   R:=Round((Palette[N*3+0]*2.5+Palette[M*3+0]*1)/3.5);
  26.   G:=Round((Palette[N*3+1]*2.5+Palette[M*3+1]*1)/3.5);
  27.   B:=Round((Palette[N*3+2]*2.5+Palette[M*3+2]*1)/3.5);
  28.   NearDist:=65535;
  29.   For I:=0 to 255 Do Begin
  30.    Rd:=Palette[I*3+0]-R;
  31.    Gd:=Palette[I*3+1]-G;
  32.    Bd:=Palette[I*3+2]-B;
  33.    Dist:=Rd*Rd+Gd*Gd+Bd*Bd;
  34.    If Dist<NearDist Then Begin NearDist:=Dist; Col:=I; End;
  35.   End;
  36.   Mem[ColorSeg:N+M Shl 8]:=Col;
  37.   GotoXY(1,1); Write(100*N/255:5:1,'%');
  38.  End;
  39.  Assign(Fil,'AALIAS.DAT'); ReWrite(Fil,1);
  40. { BlockWrite(Fil,Palette,768);}
  41.  BlockWrite(Fil,Mem[ColorSeg:0],32768);
  42.  BlockWrite(Fil,Mem[ColorSeg:32768],32768); Close(Fil);
  43.  
  44.  Asm Mov Ax,0013h; Int 10h; End;
  45.  Port[$3C8]:=0; For N:=0 to 767 Do Port[$3C9]:=Palette[N];
  46.  For N:=0 to 255 Do For M:=0 to 199 Do Mem[$A000:N+M*320]:=N;
  47.  Repeat Until KeyPressed;
  48.  Asm Mov Ax,0003h; Int 10h; End;
  49. End.
  50.